home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0086_Get-Set DOS Serial NUmber.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  2KB  |  90 lines
  1. {
  2.   Finding (and dare we say "changing" the DOS serial #)...
  3.   I too would like to see Borland add this to the DOS unit.
  4.   I suspect it's not there because the interrupts to
  5.   acquire the data are not supported.  Be that as it may,
  6.   I've excerpted two procedures from my "WhatDosOttaHave"
  7.   unit.
  8.  
  9. }
  10. unit xdos;
  11.  
  12. Interface
  13.   function  GetVolSerialNo(DriveNo:Byte): string;
  14.   Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
  15.  
  16. Implementation
  17. uses dos,crt;
  18.  
  19. type
  20.   SerNo_type       =
  21.                      record
  22.                      case integer of
  23.                        0: (SerNo1, SerNo2    : word);
  24.                        1: (SerNo              : longint);
  25.                      end;
  26.  
  27.   DiskSerNoInfo_type = record
  28.                      Infolevel : word;
  29.                      VolSerNo  : SerNo_Type;
  30.                      VolLabel  : array[1..11] of char;
  31.                      FileSys   : array[1..8] of char;
  32.                      end;
  33.  
  34.  
  35. function HexDigit(N : Byte) : char;
  36. begin
  37.   if n < 10 then HexDigit := Chr(Ord('0')+n)
  38.   else           HexDigit := Chr(Ord('A') + (n - 10));
  39. end;
  40.  
  41.  
  42. function GetVolSerialNo(DriveNo:Byte): string;
  43. var
  44.   ReturnArray                  : DiskSerNoInfo_type;
  45.   Regs                         : Registers;
  46. begin
  47.   with regs do begin
  48.     AX := $440d;
  49.     BL := DriveNo;
  50.     CH := $08;
  51.     CL := $66;
  52.     DS := Seg(ReturnArray);
  53.     DX := Ofs(ReturnArray);
  54.     Intr($21,Regs);
  55.     if (Flags and FCarry)<>0 then GetVolSerialNo := '' else
  56.     with ReturnArray.VolSerNo do
  57.     GetVolSerialNo :=HexDigit(Hi(SerNo2) Div 16) + HexDigit(Hi(SerNo2) Mod 16)
  58.     + HexDigit(Lo(SerNo2) Div 16) + HexDigit(Lo(SerNo2) Mod 16)
  59.     + HexDigit(Hi(SerNo1) Div 16) + HexDigit(Hi(SerNo1) Mod 16)
  60.     + HexDigit(Lo(SerNo1) Div 16) + HexDigit(Lo(SerNo1) Mod
  61.     16);  end;
  62. end;
  63.  
  64. Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
  65. var
  66.   ReturnArray                  : DiskSerNoInfo_type;
  67.   Regs                         : Registers;
  68. begin
  69.   with regs do begin
  70.     AX := $440d;
  71.     BL := DriveNo;
  72.     CH := $08;
  73.     CL := $66;
  74.     DS := Seg(ReturnArray);
  75.     DX := Ofs(ReturnArray);
  76.     Intr($21,Regs);
  77.     if (Flags and FCarry)=0 then begin
  78.        ReturnArray.VolSerNo.SerNo := SerialNo;
  79.        AH := $69;
  80.        BL := DriveNo;
  81.        AL := $01;
  82.        DS := Seg(ReturnArray);
  83.        DX := Ofs(ReturnArray);
  84.        Intr($21,Regs);
  85.     end;
  86.   end;
  87. end;
  88.  
  89. end.
  90.